School gardens in urban Hanoi
We model a decision impact pathway is for school gardens as a general intervention for sustainable children’s food environments in urban Hanoi, Vietnam (Whitney et al. 2024).
Conceptual model of school gardens as an intervention. Should urban Hanoi school boards invest time and money in creating school gardens? Should they invest in formal STEM education as part of these gardens?
Urban Hanoi school garden
Simulation of the school garden intervention options:
# Source our model
source("Garden_Model.R")
# Ensure consistent results with the random number generator
# not for each 'run' of the MC simulation but for
# consistency each time we run the entire simulation
set.seed(42)
garden_simulation_results <- mcSimulation(
estimate = estimate_read_csv("data/inputs_school_garden.csv"),
model_function = school_garden_function,
numberOfModelRuns = 1e4, #run 10,000 times
functionSyntax = "plainNames"
)The Net Present Value (i.e. current value of the future benefits) of the garden decision options over 5 years of the intervention. For public and private schools the STEM costs are considered to be in the same garden space but with the additional costs and benefits of a full STEM education program. All options are compared to the same years of using the land for something that is not related to the garden, i.e. as a playground or for parking. Here we plot the distribution for the decision and frame the projected NPV.
For public schools:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_public_school_inclusive",
"NPV_garden_STEM_public_school_inclusive"),
old_names = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
new_names = c("NPV public school garden", "NPV public school garden with STEM"),
method = 'smooth_simple_overlay',
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
For private schools:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
new_names = c("NPV private school garden","NPV private school with STEM"),
method = 'smooth_simple_overlay',
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
The same results again but this time as boxplots:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive", "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive", "NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
new_names = c("NPV private school garden","NPV private school with STEM", "NPV public school garden", "NPV public school garden with STEM"),
method = "boxplot",
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
ggsave("figures/boxplots_all.png", width = 15, height = 8, units = "cm")As boxplots and distributions for public schools:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
old_names = c("NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive"),
new_names = c("NPV public school garden", "NPV public school garden with STEM"),
method = "boxplot_density",
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
As boxplots and distributions for private schools:
source("functions/plot_distributions.R")
plot_distributions(mcSimulation_object = garden_simulation_results,
vars = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
old_names = c("NPV_garden_inclusive","NPV_garden_STEM_inclusive"),
new_names = c("NPV private school garden","NPV private school with STEM"),
method = "boxplot_density",
base_size = 7,
x_axis_name = "Comparative NPV outcomes")
Summary of results for the decision
Summary of the NPVs for the passive education garden and STEM options for private schools:
summary(garden_simulation_results$y[1:2]) #"NPV_garden_inclusive" "NPV_garden_STEM_inclusive"## NPV_garden_inclusive NPV_garden_STEM_inclusive
## Min. :-1005 Min. :-3531.5
## 1st Qu.: 722 1st Qu.: 219.8
## Median : 1413 Median : 904.2
## Mean : 1668 Mean : 1106.9
## 3rd Qu.: 2327 3rd Qu.: 1783.8
## Max. :11176 Max. :11145.9Summary of the NPVs for the passive education garden and STEM options for public schools:
summary(garden_simulation_results$y[3:4]) #"NPV_garden_public_school_inclusive" "NPV_garden_STEM_public_school_inclusive"## NPV_garden_public_school_inclusive NPV_garden_STEM_public_school_inclusive
## Min. :-1005.2 Min. :-3531.5
## 1st Qu.: -221.7 1st Qu.: -265.3
## Median : 537.1 Median : -125.1
## Mean : 910.1 Mean : 431.1
## 3rd Qu.: 1643.5 3rd Qu.: 911.7
## Max. : 8301.3 Max. : 7432.2Summary of the child health outcomes for private and public schools:
summary(garden_simulation_results$y[10:11]) #"health" "health_STEM" ## health health_STEM
## Min. : 0.0 Min. : 0.0
## 1st Qu.: 269.9 1st Qu.: 248.3
## Median : 688.4 Median : 567.7
## Mean : 749.2 Mean : 583.6
## 3rd Qu.:1094.9 3rd Qu.: 859.2
## Max. :5242.5 Max. :3290.4Summary of the biodiversity outcomes for the passive education garden and STEM options for private and public schools:
summary(garden_simulation_results$y[9]) #"biodiversity"## biodiversity
## Min. : 0.000
## 1st Qu.: 3.815
## Median :10.023
## Mean :10.118
## 3rd Qu.:15.098
## Max. :55.364Summary of costs
Total expected costs for a school garden with and without STEM education:
summary(garden_simulation_results$y[12:13])## total_costs total_costs_STEM
## Min. : 87.33 Min. : 143.1
## 1st Qu.: 199.98 1st Qu.: 357.2
## Median : 435.41 Median : 839.6
## Mean : 398.83 Mean : 929.8
## 3rd Qu.: 514.87 3rd Qu.:1252.3
## Max. :1474.13 Max. :5011.9First year expected costs for a school garden:
summary(garden_simulation_results$y$Cashflow_garden1)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -606.721 -95.383 8.306 65.859 174.797 1869.821First year expected costs for a school garden with STEM education:
summary(garden_simulation_results$y$Cashflow_garden_STEM1)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -943.72 -237.06 -121.76 -77.60 44.09 1772.05Projection to Latent Structures (PLS)
We use Projection to Latent Structures (PLS) model to assess the
correlation strength and direction for model variables and outcome
variables. The Partial Least Squares is fitted with the orthogonal
scores algorithm with pls::plsr.
PLS for private schools:
# For passive education garden option
source("functions/pls_model.R")
pls_result <- pls_model(object = garden_simulation_results,
resultName = names(garden_simulation_results$y)[1], # the "NPV_garden_inclusive"
ncomp = 1)
# read in the common input table
input_table <- read.csv("data/inputs_school_garden.csv")
label_private_school <- "Private school"
# source the plot function
source("functions/plot_pls.R")
plot_pls_garden <- plot_pls(plsrResults = pls_result,
input_table = input_table,
threshold = 0.9) +
theme(legend.position = "none", axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks = element_blank()) + scale_x_continuous(limits = c(0, 7)) + ggtitle(label_private_school) +
annotate(geom="text", x=5, y=1, label="Garden")## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.#For school garden with formal STEM education
pls_result_STEM <- pls_model(object = garden_simulation_results,
resultName = names(garden_simulation_results$y)[2], # the "NPV_garden_STEM"
ncomp = 1)
plot_pls_STEM <- plot_pls(plsrResults = pls_result_STEM,
input_table = input_table,
threshold = 0.9) +
scale_x_continuous(limits = c(0, 7)) +
annotate(geom="text", x=5, y=1, label="STEM garden")## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.plot_pls_garden / plot_pls_STEM 
Interpretation of PLS results for private schools
Garden options for private schools:
source("functions/pls_posthoc.R")
pls_posthoc(plsrResults = pls_result, threshold = 0.9)## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.362
## y 81.550
## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.362
## y 81.550
## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.362
## y 81.550
## PLS Model Summary:
## Number of Components: 1
## R-squared Value for Y:
## % Variance Explained in X:
## % Variance Explained in Y:
##
## Important Variables (VIP > 0.9):
## Variable
## if_community_likes if_community_likes
## garden_mental_health_value garden_mental_health_value
## child_garden_health_care_savings child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## VIP Coefficient
## if_community_likes 3.5792283 483.3609
## garden_mental_health_value 1.8078520 244.1434
## child_garden_health_care_savings 3.0931584 417.7190
## child_garden_school_performance_value 0.9011608 121.6983
## school_event_value 6.0637930 818.8917
## school_event_freq 2.9659178 400.5357## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
##
## $r_squared
## NULL
##
## $explained_variance_x
## NULL
##
## $explained_variance_y
## NULL
##
## $important_vars
## Variable
## if_community_likes if_community_likes
## garden_mental_health_value garden_mental_health_value
## child_garden_health_care_savings child_garden_health_care_savings
## child_garden_school_performance_value child_garden_school_performance_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## VIP Coefficient
## if_community_likes 3.5792283 483.3609
## garden_mental_health_value 1.8078520 244.1434
## child_garden_health_care_savings 3.0931584 417.7190
## child_garden_school_performance_value 0.9011608 121.6983
## school_event_value 6.0637930 818.8917
## school_event_freq 2.9659178 400.5357STEM options for private schools:
pls_posthoc(plsrResults = pls_result_STEM, threshold = 0.9)## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.364
## y 75.237
## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.364
## y 75.237
## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.364
## y 75.237
## PLS Model Summary:
## Number of Components: 1
## R-squared Value for Y:
## % Variance Explained in X:
## % Variance Explained in Y:
##
## Important Variables (VIP > 0.9):
## Variable
## if_community_likes if_community_likes
## annual_teacher_training annual_teacher_training
## garden_mental_health_value garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## VIP Coefficient
## if_community_likes 3.623407 486.4791
## annual_teacher_training 2.699158 -362.3893
## garden_mental_health_value 1.776662 238.5348
## child_STEM_community_engagement_value 1.317011 176.8220
## school_event_value 6.120904 821.7933
## school_event_freq 2.935882 394.1719## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
##
## $r_squared
## NULL
##
## $explained_variance_x
## NULL
##
## $explained_variance_y
## NULL
##
## $important_vars
## Variable
## if_community_likes if_community_likes
## annual_teacher_training annual_teacher_training
## garden_mental_health_value garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## VIP Coefficient
## if_community_likes 3.623407 486.4791
## annual_teacher_training 2.699158 -362.3893
## garden_mental_health_value 1.776662 238.5348
## child_STEM_community_engagement_value 1.317011 176.8220
## school_event_value 6.120904 821.7933
## school_event_freq 2.935882 394.1719PLS for public schools:
# For passive education garden option
source("functions/pls_model.R")
pls_result_garden_public <- pls_model(object = garden_simulation_results,
resultName = names(garden_simulation_results$y)[3],
# "NPV_garden_public_school"
ncomp = 1)
# read in the common input table
input_table <- read.csv("data/inputs_school_garden.csv")
label_public_school <- "Public school"
# source the plot function
source("functions/plot_pls.R")
plot_pls_garden_public <- plot_pls(pls_result_garden_public,
input_table = input_table, threshold = 0.9) +
theme(legend.position = "none", axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks = element_blank()) +
scale_x_continuous(limits = c(0, 7)) + ggtitle(label_public_school) +
annotate(geom="text", x=5, y=1, label="Garden")## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.#For school garden with formal STEM education
pls_result_STEM_public <- pls_model(object = garden_simulation_results,
resultName = names(garden_simulation_results$y)[4],
# "NPV_garden_STEM_public_school"
ncomp = 1)
plot_pls_public_STEM <- plot_pls(pls_result_STEM_public,
input_table = input_table, threshold = 0.9) + scale_x_continuous(limits = c(0, 7)) +
annotate(geom="text", x=5, y=1, label="STEM garden")## Scale for x is already present.
## Adding another scale for x, which will replace the existing scale.plot_pls_garden_public / plot_pls_public_STEM 
Interpretation of PLS results for public schools
Garden option in public school:
pls_posthoc(plsrResults = pls_result_garden_public, threshold = 0.9)## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.371
## y 34.692
## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.371
## y 34.692
## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.371
## y 34.692
## PLS Model Summary:
## Number of Components: 1
## R-squared Value for Y:
## % Variance Explained in X:
## % Variance Explained in Y:
##
## Important Variables (VIP > 0.9):
## Variable VIP
## if_community_likes if_community_likes 3.222189
## garden_mental_health_value garden_mental_health_value 1.654486
## child_garden_health_care_savings child_garden_health_care_savings 2.670497
## school_event_value school_event_value 5.741691
## school_event_freq school_event_freq 2.817428
## suitability_of_land_for_garden suitability_of_land_for_garden 1.797024
## beurocratic_barriers beurocratic_barriers 2.488932
## Coefficient
## if_community_likes 292.2914
## garden_mental_health_value 150.0819
## child_garden_health_care_savings 242.2463
## school_event_value 520.8408
## school_event_freq 255.5748
## suitability_of_land_for_garden 163.0118
## beurocratic_barriers -225.7762## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
##
## $r_squared
## NULL
##
## $explained_variance_x
## NULL
##
## $explained_variance_y
## NULL
##
## $important_vars
## Variable VIP
## if_community_likes if_community_likes 3.222189
## garden_mental_health_value garden_mental_health_value 1.654486
## child_garden_health_care_savings child_garden_health_care_savings 2.670497
## school_event_value school_event_value 5.741691
## school_event_freq school_event_freq 2.817428
## suitability_of_land_for_garden suitability_of_land_for_garden 1.797024
## beurocratic_barriers beurocratic_barriers 2.488932
## Coefficient
## if_community_likes 292.2914
## garden_mental_health_value 150.0819
## child_garden_health_care_savings 242.2463
## school_event_value 520.8408
## school_event_freq 255.5748
## suitability_of_land_for_garden 163.0118
## beurocratic_barriers -225.7762STEM option in public school:
pls_posthoc(plsrResults = pls_result_STEM_public, threshold = 0.9)## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.361
## y 45.117
## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.361
## y 45.117
## Data: X dimension: 10000 75
## Y dimension: 10000 1
## Fit method: oscorespls
## Number of components considered: 1
## TRAINING: % variance explained
## 1 comps
## X 1.361
## y 45.117
## PLS Model Summary:
## Number of Components: 1
## R-squared Value for Y:
## % Variance Explained in X:
## % Variance Explained in Y:
##
## Important Variables (VIP > 0.9):
## Variable
## if_community_likes if_community_likes
## annual_teacher_training annual_teacher_training
## garden_mental_health_value garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## suitability_of_land_for_garden suitability_of_land_for_garden
## beurocratic_barriers beurocratic_barriers
## VIP Coefficient
## if_community_likes 3.352871 303.19595
## annual_teacher_training 3.323785 -300.56570
## garden_mental_health_value 1.649034 149.12007
## child_STEM_community_engagement_value 1.233191 111.51589
## school_event_value 5.835963 527.73884
## school_event_freq 2.776369 251.06362
## suitability_of_land_for_garden 1.000465 90.47077
## beurocratic_barriers 1.433234 -129.60556## $plsrResults
## Partial least squares regression, fitted with the orthogonal scores algorithm.
## Call:
## plsr(formula = y ~ x, ncomp = ncomp, method = "oscorespls", scale = scale)
##
## $r_squared
## NULL
##
## $explained_variance_x
## NULL
##
## $explained_variance_y
## NULL
##
## $important_vars
## Variable
## if_community_likes if_community_likes
## annual_teacher_training annual_teacher_training
## garden_mental_health_value garden_mental_health_value
## child_STEM_community_engagement_value child_STEM_community_engagement_value
## school_event_value school_event_value
## school_event_freq school_event_freq
## suitability_of_land_for_garden suitability_of_land_for_garden
## beurocratic_barriers beurocratic_barriers
## VIP Coefficient
## if_community_likes 3.352871 303.19595
## annual_teacher_training 3.323785 -300.56570
## garden_mental_health_value 1.649034 149.12007
## child_STEM_community_engagement_value 1.233191 111.51589
## school_event_value 5.835963 527.73884
## school_event_freq 2.776369 251.06362
## suitability_of_land_for_garden 1.000465 90.47077
## beurocratic_barriers 1.433234 -129.60556Value of Information
Here we assess value of information with the multi_EVPI
function. We calculate value of information in the form of Expected
Value of Perfect Information (EVPI).
# Subset the outputs from the mcSimulation function (y) by selecting the correct variables be sure to run the multi_EVPI only on the variables that we want. Find them with names(garden_simulation_results$y)
mcSimulation_table <- data.frame(garden_simulation_results$x,
garden_simulation_results$y[1:4])
# List of NPV variables to move to the last position (calculate 4 EVPIs only)
npvs_to_move <- c("NPV_garden_inclusive", "NPV_garden_STEM_inclusive",
"NPV_garden_public_school_inclusive", "NPV_garden_STEM_public_school_inclusive")
# Move NPV variables to the last position
mcSimulation_table <- mcSimulation_table %>% select(-all_of(npvs_to_move), all_of(npvs_to_move))Calculate EVPI:
source("functions/multi_EVPI_test.R")
# evpi <- multi_EVPI_test(mc = mcSimulation_table, first_out_var = "NPV_garden_inclusive")
# save as a local .csv (takes ~ 15 minutes to run this)
# save(evpi,file="data/data_evpi.Rda")
load("data/data_evpi.Rda")
# open from saved file (last model run) - it is stable result / takes very long to run EVPI for private schools:
#Value of information the garden intervention decision
source("functions/plot_evpi.R")
#plot_evpi_garden <- plot_evpi(EVPIresults = evpi,
# decision_vars = "NPV_garden_inclusive",
# new_names = "Garden",
# input_table = input_table,
# threshold = 10) +
# theme(legend.position = "none", axis.title.x = element_blank(),
# axis.text.x = element_blank(),
# axis.ticks = element_blank()) +
# scale_x_continuous(limits = c(0, 210)) + ggtitle(label_private_school) # Value of information for the garden option with formal STEM education.
# using the results of the same multi_EVPI
# plot_evpi_STEM <- plot_evpi(EVPIresults = evpi,
# decision_vars = "NPV_garden_STEM_inclusive",
# new_names = "STEM garden",
# input_table = input_table,
# threshold = 10) + scale_x_continuous(limits = c(0, 210))
# plot_evpi_garden / plot_evpi_STEMEVPI for public schools:
# Value of information for the public school garden option with no formal STEM education.
# using the results of the same multi_EVPI
# plot_evpi_public <- plot_evpi(evpi, decision_vars = "NPV_garden_public_school_inclusive",
# new_names = "Garden",
# input_table = input_table,
# threshold = 10) +
# theme(legend.position = "none", axis.title.x = element_blank(),
# axis.text.x = element_blank(),
# axis.ticks = element_blank()) +
# scale_x_continuous(limits = c(0, 210)) + ggtitle(label_public_school) #210# Value of information for the public school garden option with formal STEM education.
# using the results of the same multi_EVPI
plot_evpi_public_STEM <- plot_evpi(evpi, decision_vars = "NPV_garden_STEM_public_school_inclusive",
new_names = "STEM garden",
input_table = input_table,
threshold = 10) # +
# scale_x_continuous(limits = c(0, 210)) #210
plot_evpi_public_STEM
# plot_evpi_public / plot_evpi_public_STEMCash flows
Cash flow plots of the garden option without formal STEM education. These are the expected returns for public and private schools over the intervention.
# Cashflow of the garden option without formal STEM education
# This will be the cost for public and private schools over the intervention.
source("functions/plot_cashflow.R")
plot_cashflow_garden <- plot_cashflow(mcSimulation_object = garden_simulation_results,
cashflow_var_name = "Cashflow_garden",
facet_labels = "Garden") +
theme(legend.position = "none", axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks = element_blank())
# Cashflow of the garden option with formal STEM education
source("functions/plot_cashflow.R")
plot_cashflow_STEM <- plot_cashflow(mcSimulation_object = garden_simulation_results,
cashflow_var_name = "Cashflow_garden_STEM",
facet_labels = "STEM Garden")
# # manually share axis label (not a feature of patchwork)
#
# ylab <- plot_cashflow_garden$labels$y
# plot_cashflow_garden$labels$y <- plot_cashflow_STEM$labels$y <- " "
#
# h_patch <- plot_cashflow_garden / plot_cashflow_STEM
# # Use the tag label as a y-axis label
# wrap_elements(h_patch) +
# labs(tag = "Cashflow") +
# theme(
# plot.tag = element_text(size = rel(1), angle = 90),
# plot.tag.position = "left"
# )
plot_cashflow_garden / plot_cashflow_STEM
ggsave("figures/Fig_9_cashflow.png", width=5, height=5) Pareto-optimal solutions
These figures display the Pareto-optimal solutions, representing the best trade-offs among the objectives of biodiversity, child health, and economic return. By focusing on these Pareto-optimal points, the analysis highlights solutions where improvements in one objective cannot be achieved without some compromise in at least one other.
Private schools Pareto-optimal solutions:
source("functions/plot_pareto.R")
private_pareto <- plot_pareto(
economic_return_garden = garden_simulation_results$y$NPV_garden,
health_garden = garden_simulation_results$y$health,
biodiversity_garden = garden_simulation_results$y$biodiversity,
economic_return_STEM = garden_simulation_results$y$NPV_garden_STEM,
health_STEM = garden_simulation_results$y$health_STEM,
biodiversity_STEM = garden_simulation_results$y$biodiversity,
plot_return = "scatter"
)
ggplotly(private_pareto) knitr::include_graphics("figures/private_pareto_scatter.png")
knitr::include_graphics("figures/private_pareto_surface.png")
Private school Pareto-optimal solutions interpretation:
source("functions/pareto_posthoc.R")
private_pareto_posthoc <- pareto_posthoc(
economic_return_garden = garden_simulation_results$y$NPV_garden,
health_garden = garden_simulation_results$y$health,
biodiversity_garden = garden_simulation_results$y$biodiversity,
economic_return_STEM = garden_simulation_results$y$NPV_garden_STEM,
health_STEM = garden_simulation_results$y$health_STEM,
biodiversity_STEM = garden_simulation_results$y$biodiversity
)## Number of Pareto-optimal points for STEM option: 46
## Number of Pareto-optimal points for Garden option: 63
##
## Summary of Pareto-optimal points for STEM option:
## economic_return biodiversity health
## Min. : -576.6 Min. : 518.4 Min. : 6.826
## 1st Qu.: 808.4 1st Qu.:1212.0 1st Qu.:24.534
## Median : 2049.9 Median :1608.5 Median :30.858
## Mean : 2696.0 Mean :1911.0 Mean :29.955
## 3rd Qu.: 4069.3 3rd Qu.:2614.8 3rd Qu.:34.395
## Max. :10218.6 Max. :5242.5 Max. :55.364
##
## Summary of Pareto-optimal points for Garden option:
## economic_return biodiversity health
## Min. :-2564.8 Min. : 348.8 Min. : 6.826
## 1st Qu.: 906.8 1st Qu.:1040.1 1st Qu.:17.408
## Median : 2235.0 Median :1436.0 Median :23.266
## Mean : 2472.2 Mean :1486.3 Mean :25.517
## 3rd Qu.: 3802.2 3rd Qu.:1873.5 3rd Qu.:32.132
## Max. :10175.3 Max. :3290.4 Max. :55.364private_pareto_posthoc## $num_pareto_stem
## [1] 46
##
## $num_pareto_garden
## [1] 63
##
## $stem_summary
## economic_return biodiversity health
## Min. : -576.6 Min. : 518.4 Min. : 6.826
## 1st Qu.: 808.4 1st Qu.:1212.0 1st Qu.:24.534
## Median : 2049.9 Median :1608.5 Median :30.858
## Mean : 2696.0 Mean :1911.0 Mean :29.955
## 3rd Qu.: 4069.3 3rd Qu.:2614.8 3rd Qu.:34.395
## Max. :10218.6 Max. :5242.5 Max. :55.364
##
## $garden_summary
## economic_return biodiversity health
## Min. :-2564.8 Min. : 348.8 Min. : 6.826
## 1st Qu.: 906.8 1st Qu.:1040.1 1st Qu.:17.408
## Median : 2235.0 Median :1436.0 Median :23.266
## Mean : 2472.2 Mean :1486.3 Mean :25.517
## 3rd Qu.: 3802.2 3rd Qu.:1873.5 3rd Qu.:32.132
## Max. :10175.3 Max. :3290.4 Max. :55.364Public schools Pareto-optimal solutions:
source("functions/plot_pareto.R")
public_pareto <- plot_pareto(
economic_return_garden = garden_simulation_results$y$NPV_garden_public_school,
health_garden = garden_simulation_results$y$health,
biodiversity_garden = garden_simulation_results$y$biodiversity,
economic_return_STEM = garden_simulation_results$y$NPV_garden_STEM_public_school,
health_STEM = garden_simulation_results$y$health_STEM,
biodiversity_STEM = garden_simulation_results$y$biodiversity,
plot_return = "scatter"
)
ggplotly(public_pareto) knitr::include_graphics("figures/public_pareto_scatter.png")
knitr::include_graphics("figures/public_pareto_surface.png")
Public school Pareto-optimal solutions interpretation:
source("functions/pareto_posthoc.R")
public_pareto_posthoc <- pareto_posthoc(
economic_return_garden = garden_simulation_results$y$NPV_garden_public_school,
health_garden = garden_simulation_results$y$health,
biodiversity_garden = garden_simulation_results$y$biodiversity,
economic_return_STEM = garden_simulation_results$y$NPV_garden_STEM_public_school,
health_STEM = garden_simulation_results$y$health_STEM,
biodiversity_STEM = garden_simulation_results$y$biodiversity
)## Number of Pareto-optimal points for STEM option: 52
## Number of Pareto-optimal points for Garden option: 68
##
## Summary of Pareto-optimal points for STEM option:
## economic_return biodiversity health
## Min. :-576.6 Min. : 0.0 Min. : 0.00
## 1st Qu.: 799.9 1st Qu.: 984.3 1st Qu.:19.46
## Median :2839.3 Median :1271.5 Median :25.67
## Mean :2922.1 Mean :1641.2 Mean :25.95
## 3rd Qu.:5149.2 3rd Qu.:1911.0 3rd Qu.:33.11
## Max. :7138.2 Max. :5242.5 Max. :55.36
##
## Summary of Pareto-optimal points for Garden option:
## economic_return biodiversity health
## Min. :-2564.849 Min. : 142.2 Min. : 6.826
## 1st Qu.: 6.723 1st Qu.: 943.9 1st Qu.:16.627
## Median : 1915.114 Median :1399.7 Median :22.525
## Mean : 2058.484 Mean :1467.9 Mean :24.000
## 3rd Qu.: 3902.278 3rd Qu.:1943.5 3rd Qu.:29.699
## Max. : 6583.169 Max. :3290.4 Max. :55.364public_pareto_posthoc## $num_pareto_stem
## [1] 52
##
## $num_pareto_garden
## [1] 68
##
## $stem_summary
## economic_return biodiversity health
## Min. :-576.6 Min. : 0.0 Min. : 0.00
## 1st Qu.: 799.9 1st Qu.: 984.3 1st Qu.:19.46
## Median :2839.3 Median :1271.5 Median :25.67
## Mean :2922.1 Mean :1641.2 Mean :25.95
## 3rd Qu.:5149.2 3rd Qu.:1911.0 3rd Qu.:33.11
## Max. :7138.2 Max. :5242.5 Max. :55.36
##
## $garden_summary
## economic_return biodiversity health
## Min. :-2564.849 Min. : 142.2 Min. : 6.826
## 1st Qu.: 6.723 1st Qu.: 943.9 1st Qu.:16.627
## Median : 1915.114 Median :1399.7 Median :22.525
## Mean : 2058.484 Mean :1467.9 Mean :24.000
## 3rd Qu.: 3902.278 3rd Qu.:1943.5 3rd Qu.:29.699
## Max. : 6583.169 Max. :3290.4 Max. :55.364Input data for the simulations
Summary
Here we provide a summary of the garden intervention options. We do
this with a summary table of the simulation results. We show the
percentage of missing values as well as the mean, median and standard
deviation (SD) for each output of our model simulations. We use the
gt_plt_summary() from {gtExtras} and with options from
{svglite}. The table shows the name, the plot overview as well as the
number of missing values, the mean, median and the standard deviation of
the distribution for all variables that were fed into the model from our
input table of uncertainty values.
# Subset the outputs from the mcSimulation function (y) to summarize only on the variables that we want.
# names(garden_simulation_results$x)
mcSimulation_table_x <- data.frame(garden_simulation_results$x[4:7]) #, 21:30, 32:41, 43:70, 73:76) also of possible interest
gtExtras::gt_plt_summary(mcSimulation_table_x) | mcSimulation_table_x | ||||||
| 10000 rows x 4 cols | ||||||
| Column | Plot Overview | Missing | Mean | Median | SD | |
|---|---|---|---|---|---|---|
| inflation_rate | 0.0% | 7.5 | 7.5 | 1.5 | ||
| size_of_garden | 0.0% | 45.7 | 41.8 | 29.6 | ||
| expensive_garden_size | 0.0% | 87.4 | 87.5 | 4.5 | ||
| cost_increase_expensive_garden_size | 0.0% | 1.8 | 1.8 | 0.4 | ||
# a summary table with missing, mean, median and sdThe table shows the variable name, the plot overview as well as the number of missing values, the mean, median and the standard deviation of the distribution for variables that calculated in the model.
The full repository can be accessed at https://github.com/CWWhitney/urban_school_gardens